************************************************** *-- Class Library: \vfp\ffc\_base.prg ************************************************** ************************************************** *-- Class: _column (\vfp\ffc\_base.prg) *-- ParentClass: column *-- BaseClass: column * DEFINE CLASS _column AS column Name = "_column" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _column ************************************************** ************************************************** *-- Class: _cursor (\vfp\ffc\_base.prg) *-- ParentClass: cursor *-- BaseClass: cursor * DEFINE CLASS _cursor AS cursor Name = "_cursor" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _cursor ************************************************** ************************************************** *-- Class: _dataenvironment (\vfp\ffc\_base.prg) *-- ParentClass: dataenvironment *-- BaseClass: dataenvironment * DEFINE CLASS _dataenvironment AS dataenvironment Name = "_dataenvironment" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _dataenvironment ************************************************** ************************************************** *-- Class: _header (\vfp\ffc\_base.prg) *-- ParentClass: header *-- BaseClass: header * DEFINE CLASS _header AS header Name = "_header" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _header ************************************************** ************************************************** *-- Class: _olecontrol (\vfp\ffc\_base.prg) *-- ParentClass: olecontrol *-- BaseClass: olecontrol * DEFINE CLASS _olecontrol AS olecontrol Name = "_olecontrol" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _olecontrol ************************************************** ************************************************** *-- Class: _oleboundcontrol (\vfp\ffc\_base.prg) *-- ParentClass: oleboundcontrol *-- BaseClass: oleboundcontrol * DEFINE CLASS _oleboundcontrol AS oleboundcontrol Name = "_oleboundcontrol" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _oleboundcontrol ************************************************** ************************************************** *-- Class: _optionbutton (\vfp\ffc\_base.prg) *-- ParentClass: optionbutton *-- BaseClass: optionbutton * DEFINE CLASS _optionbutton AS optionbutton Name = "_optionbutton" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _optionbutton ************************************************** ************************************************** *-- Class: _page (\vfp\ffc\_base.prg) *-- ParentClass: page *-- BaseClass: page * DEFINE CLASS _page AS page Name = "_page" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _page ************************************************** ************************************************** *-- Class: _relation (\vfp\ffc\_base.prg) *-- ParentClass: relation *-- BaseClass: relation * DEFINE CLASS _relation AS relation Name = "_relation" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _relation ************************************************** ************************************************** *-- Class: _session (\vfp\ffc\_base.prg) *-- ParentClass: session *-- BaseClass: session * DEFINE CLASS _session AS session Name = "_session" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _session ************************************************** ************************************************** *-- Class: _exception (\vfp\ffc\_base.prg) *-- ParentClass: exception *-- BaseClass: exception * DEFINE CLASS _exception AS exception Name = "_exception" cVersion = "" Builder = "" BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm") oHost = .NULL. vResult = .T. cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") lAutoBuilder = .F. lAutoSetObjectRefs = .F. lRelease = .F. lIgnoreErrors = .F. lSetHost = .F. nInstances = 0 nObjectRefCount = 0 DIMENSION aObjectRefs[1,3] PROCEDURE nInstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE nInstances_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE release IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. this.oHost=.NULL. this.ReleaseObjRefs RELEASE this ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors OR _vfp.StartMode>0 RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC ENDDEFINE * *-- EndDefine: _exception **************************************************